Introduction

In this Rmarkdown document we are going to create the spatial pannels necessary for Figure 2.

To do this we will load the MAGIC-denoised data to better visualize genes and ease with the annotation when using specific marker genes. The MAGIC denoised data was generated in the script spatial_transcriptomics/CD4-analysis/MAGIC_denoising.Rmd.

Libraries

library(Seurat)
library(ggpubr)
library(cowplot)
library(dplyr)
library(ggplot2)
library(SPATA2)

Setting parameters

Loading necessary paths and parameters

set.seed(123)
source(here::here("misc/paths.R"))
source(here::here("utils/bin.R"))

"{fig2}/{plt_dir}" %>%
  glue::glue() %>%
  here::here() %>%
  dir.create(path = .,
             showWarnings = FALSE,
             recursive = TRUE)

"{fig2}/{robj_dir}" %>%
  glue::glue() %>%
  here::here() %>%
  dir.create(path = .,
             showWarnings = FALSE,
             recursive = TRUE)

Load data

The data used in this Rmarkdown document comes from 03-clustering_integration.Rmd where the data was integrated.

merged_se <- "misc/{robj_dir}/20220215_tonsil_atlas_spatial_seurat_obj.rds" %>%
  glue::glue() %>%
  here::here() %>%
  readRDS(file = .)

# Load SPOTlight data
spotlight_ls <- "{cd4}/{robj_dir}/spotlight_ls_cd4_new.rds" %>%
  glue::glue() %>% 
  here::here() %>%
  readRDS(file = .)

# Load SPOTlight data
nm_df <- "{cd4}/{robj_dir}/cd4_nm_df.rds" %>%
  glue::glue() %>% 
  here::here() %>%
  readRDS(file = .)

Preprocess data

decon_mtrx <- spotlight_ls[[2]]
decon_mtrx <- decon_mtrx[, colnames(decon_mtrx) != "res_ss"]

# Set as 0 cell types predicted to be under 3 % of the spot
decon_mtrx[decon_mtrx < 0.03] <- 0

Change column names

new_cn <- data.frame(mod_nm = colnames(decon_mtrx)) %>%
  dplyr::left_join(nm_df, by = "mod_nm") %>%
  dplyr::mutate(plt_nm = dplyr::if_else(is.na(plt_nm), mod_nm, plt_nm)) %>%
  dplyr::distinct() %>%
  dplyr::pull(plt_nm)

colnames(decon_mtrx) <- new_cn

We are going to add the deconvolution to the Seurat object.

merged_se@meta.data <- cbind(merged_se@meta.data, decon_mtrx)

Subset sample of interest

sample_id <- "esvq52_nluss5"
sp_sub <- merged_se[, merged_se@meta.data$gem_id == sample_id]
sp_sub@images <- sp_sub@images[Seurat::Images(sp_sub) == sample_id]

Panels

Cell types interest

Look at the location of each cell type in each slice separately

# Iterate over cell types
ct_int <- c("Naive", "GC-Tfh-0X40", "GC-Tfh-SAP", "Tfh-LZ-GC")

nm_donor <- id_sp_df %>% dplyr::filter(gem_id == sample_id) %>% dplyr::pull(donor_id)
# Iterate over cell types
ct_plt_ls <- lapply(ct_int, function(i) {
  tmp_plt <- Seurat::SpatialFeaturePlot(
    object = merged_se,
    features = i,
    alpha = c(0, 1),
    images = sample_id,
    image.alpha = 1) +
    ggplot2::scale_fill_gradientn(
      colors = heat.colors(10, rev = TRUE)) +
    ggplot2::scale_alpha(range = c(0, 1)) +
    ggplot2::labs(title = stringr::str_wrap(string = i,
                                   width = 25),
         fill = "") +
    ggplot2::theme(
      plot.title = ggplot2::element_text(
        hjust = 0.5,
        size = 20,
        face = "bold"))

  return(tmp_plt)
})

(plt_arr <- cowplot::plot_grid(
  plotlist = ct_plt_ls,
  axis = "trbl",
  align = "hv",
  nrow = 2,
  ncol = 2))

"{fig2}/{plt_dir}/Figure-2i_cd4_deconv_{nm_donor}.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = plt_arr,
    base_height = 10,
    base_width = 10)

Associated supplementary

Check Topic profiles

nmf_mod_ls <- spotlight_ls[[1]]
nmf_mod <- nmf_mod_ls[[1]]

h <- NMF::coef(nmf_mod)
rownames(h) <- paste("Topic", 1:nrow(h), sep = "_")
topic_profile_plts <- SPOTlight::dot_plot_profiles_fun(
  h = h,
  train_cell_clust = nmf_mod_ls[[2]])

(topic_diag <- topic_profile_plts[[2]] +
  ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90), 
                 axis.text = ggplot2::element_text(size = 12)))

"{fig2}/{plt_dir}/supplementary_cd4_topic_diagonal.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = topic_diag,
    base_height = 8,
    base_width = 8)

Look at all cells profiles

(topics_all <- topic_profile_plts[[1]] +
  ggplot2::theme(
    axis.text.y = ggplot2::element_blank(),
    axis.text.x = ggplot2::element_blank(),
    axis.title = ggplot2::element_blank()))

"{fig2}/{plt_dir}/supplementary_cd4_topic_all_cells.pdf" %>%
  glue::glue() %>%
  here::here() %>%
  cowplot::save_plot(
    filename = .,
    plot = topics_all,
    base_height = 20,
    base_width = 20)

All cell types

Look at the location of each cell type in each slice separately

# Iterate over cell types
ct <- colnames(decon_mtrx)

# Iterate over images
lapply(names(merged_se@images), function(nm) {
  print(nm)
  nm_donor <- id_sp_df %>% dplyr::filter(gem_id == nm) %>% dplyr::pull(donor_id)
  # Iterate over cell types
  ct_plt_ls <- lapply(ct, function(i) {
    tmp_plt <- Seurat::SpatialFeaturePlot(
      object = merged_se,
      features = i,
      alpha = c(0, 1),
      images = nm,
      image.alpha = 0) +
      ggplot2::scale_fill_gradientn(
        colors = heat.colors(10, rev = TRUE)) +
      ggplot2::scale_alpha(range = c(0, 1)) +
      ggplot2::labs(title = stringr::str_wrap(string = i,
                                     width = 25),
           fill = "") +
      ggplot2::theme(
        plot.title = ggplot2::element_text(
          hjust = 0.5,
          size = 20,
          face = "bold"))
    
    if (sum(sp_sub@meta.data[, i]) == 0) {
      tmp_plt <- suppressMessages(tmp_plt + ggplot2::scale_alpha(range = c(0,0)))
    }
    
    return(tmp_plt)
  })
  
  (plt_arr <- cowplot::plot_grid(
    plotlist = ct_plt_ls,
    axis = "trbl",
    align = "hv",
    nrow = 5,
    ncol = 5))
  
  "{fig2}/{plt_dir}/Supplementary_cell_type_location_cd4_{nm_donor}_new.pdf" %>%
    glue::glue() %>%
    here::here() %>%
    cowplot::save_plot(
      filename = .,
      plot = plt_arr,
      base_height = 25,
      base_width = 25)
  })
## [1] "tarwe1_xott6q"
## [1] "c28w2r_7jne4i"
## [1] "esvq52_nluss5"
## [1] "p7hv1g_tjgmyj"
## [1] "gcyl7c_cec61b"
## [1] "zrt7gl_lhyyar"
## [1] "qvwc8t_2vsr67"
## [1] "exvyh1_66caqq"
## [[1]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-2-T_new.pdf"
## 
## [[2]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-8-T_new.pdf"
## 
## [[3]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-10-T_new.pdf"
## 
## [[4]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-12-T_new.pdf"
## 
## [[5]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-13-T_new.pdf"
## 
## [[6]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-14-T_new.pdf"
## 
## [[7]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-9-T_new.pdf"
## 
## [[8]]
## [1] "/scratch/devel/melosua/phd/projects/BCLLatlas/tonsil_atlas/spatial_transcriptomics/Spatial-Figure-2/2020-09-22/plots_2020-09-22/Supplementary_cell_type_location_cd4_BCLL-11-T_new.pdf"

Session Info

sessionInfo()
## R version 4.0.1 (2020-06-06)
## Platform: x86_64-conda_cos6-linux-gnu (64-bit)
## Running under: Red Hat Enterprise Linux Server release 6.7 (Santiago)
## 
## Matrix products: default
## BLAS/LAPACK: /scratch/groups/singlecell/software/anaconda3/envs/spatial_r/lib/libopenblasp-r0.3.12.so
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=es_ES.UTF-8        LC_COLLATE=en_US.UTF-8     LC_MONETARY=es_ES.UTF-8    LC_MESSAGES=en_US.UTF-8    LC_PAPER=es_ES.UTF-8       LC_NAME=C                  LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=es_ES.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] tidyr_1.2.0         tibble_3.1.6        stringr_1.4.0       Biobase_2.50.0      BiocGenerics_0.36.1 SPATA2_0.1.0        dplyr_1.0.8         cowplot_1.1.1       ggpubr_0.4.0        ggplot2_3.3.5       SeuratObject_4.0.4  Seurat_4.1.0       
## 
## loaded via a namespace (and not attached):
##   [1] backports_1.4.1             NMF_0.23.0                  systemfonts_1.0.4           plyr_1.8.6                  igraph_1.2.11               lazyeval_0.2.2              splines_4.0.1               listenv_0.8.0               scattermore_0.8             gridBase_0.4-7              GenomeInfoDb_1.26.7         digest_0.6.29               foreach_1.5.2               htmltools_0.5.2             fansi_1.0.2                 magrittr_2.0.2              doParallel_1.0.17           tensor_1.5                  cluster_2.1.2               ROCR_1.0-11                 tzdb_0.2.0                  readr_2.1.2                 globals_0.14.0              matrixStats_0.61.0          vroom_1.5.7                 spatstat.sparse_2.1-0       colorspace_2.0-3            ggrepel_0.9.1               textshaping_0.3.6           xfun_0.30                   crayon_1.5.0                RCurl_1.98-1.6              jsonlite_1.8.0              spatstat.data_2.1-2         iterators_1.0.14            survival_3.3-1              zoo_1.8-9                   glue_1.6.2                  polyclip_1.10-0             registry_0.5-1              gtable_0.3.0                zlibbioc_1.36.0            
##  [43] XVector_0.30.0              leiden_0.3.9                DelayedArray_0.16.3         car_3.0-12                  future.apply_1.8.1          SingleCellExperiment_1.12.0 abind_1.4-5                 scales_1.1.1                rngtools_1.5.2              DBI_1.1.2                   rstatix_0.7.0               spatstat.random_2.1-0       miniUI_0.1.1.1              Rcpp_1.0.8                  viridisLite_0.4.0           xtable_1.8-4                reticulate_1.24             spatstat.core_2.4-0         bit_4.0.4                   stats4_4.0.1                SPOTlight_0.1.7             htmlwidgets_1.5.4           httr_1.4.2                  RColorBrewer_1.1-2          ellipsis_0.3.2              ica_1.0-2                   farver_2.1.0                pkgconfig_2.0.3             sass_0.4.0                  uwot_0.1.11                 deldir_1.0-6                here_1.0.1                  utf8_1.2.2                  labeling_0.4.2              tidyselect_1.1.2            rlang_1.0.2                 reshape2_1.4.4              later_1.3.0                 munsell_0.5.0               tools_4.0.1                 cli_3.2.0                   generics_0.1.2             
##  [85] broom_0.7.12                ggridges_0.5.3              evaluate_0.15               fastmap_1.1.0               ragg_1.2.2                  yaml_2.3.5                  goftest_1.2-3               bit64_4.0.5                 knitr_1.37                  fitdistrplus_1.1-6          purrr_0.3.4                 RANN_2.6.1                  pbapply_1.5-0               future_1.24.0               nlme_3.1-155                mime_0.12                   compiler_4.0.1              plotly_4.10.0               png_0.1-7                   ggsignif_0.6.3              spatstat.utils_2.3-0        bslib_0.3.1                 stringi_1.7.6               highr_0.9                   lattice_0.20-45             Matrix_1.4-0                vctrs_0.3.8                 pillar_1.7.0                lifecycle_1.0.1             spatstat.geom_2.3-2         lmtest_0.9-39               jquerylib_0.1.4             RcppAnnoy_0.0.19            data.table_1.14.2           bitops_1.0-7                irlba_2.3.5                 httpuv_1.6.5                patchwork_1.1.1             GenomicRanges_1.42.0        R6_2.5.1                    promises_1.2.0.1            KernSmooth_2.23-20         
## [127] gridExtra_2.3               IRanges_2.24.1              parallelly_1.30.0           codetools_0.2-18            MASS_7.3-55                 assertthat_0.2.1            SummarizedExperiment_1.20.0 pkgmaker_0.32.2             rprojroot_2.0.2             withr_2.5.0                 sctransform_0.3.3           S4Vectors_0.28.1            GenomeInfoDbData_1.2.4      hms_1.1.1                   mgcv_1.8-39                 grid_4.0.1                  rpart_4.1.16                rmarkdown_2.12              MatrixGenerics_1.2.1        carData_3.0-5               Rtsne_0.15                  shiny_1.7.1